#PBFORMS CREATED V1.51
'------------------------------------------------------------------------------
' The first line in this file is a PB/Forms metastatement.
' It should ALWAYS be the first line of the file. Other
' PB/Forms metastatements are placed at the beginning and
' end of "Named Blocks" of code that should be edited
' with PBForms only. Do not manually edit or delete these
' metastatements or PB/Forms will not be able to reread
' the file correctly.  See the PB/Forms documentation for
' more information.
' Named blocks begin like this:    #PBFORMS BEGIN ...
' Named blocks end like this:      #PBFORMS END ...
' Other PB/Forms metastatements such as:
'     #PBFORMS DECLARATIONS
' are used by PB/Forms to insert additional code.
' Feel free to make changes anywhere else in the file.
'------------------------------------------------------------------------------

#COMPILE EXE
#DIM ALL
#DEBUG ERROR ON

'------------------------------------------------------------------------------
'   ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#RESOURCE "Sparta.pbr"
%USEMACROS = 1
#IF NOT %DEF(%WINAPI)
  #INCLUDE "WIN32API.INC"
#ENDIF
#IF NOT %DEF(%COMMCTRL_INC)
  #INCLUDE "COMMCTRL.INC"
#ENDIF
#INCLUDE "PBForms.INC"
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Constants **
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDR_IMGFILE1     =  102
%IDR_IMGFILE2     =  103
%IDR_IMGFILE3     =  104
%IDD_DIALOG1      =  101
%IDC_MAP          = 1001
%IDC_IMAGE1       = 1002
%IDC_IMAGE2       = 1003
%ID_POSIT         = 1005
%IDC_NEWGAME      = 1004
%IDC_IMGicon      = 1006
%IDC_IMGTroops    = 1007
%IDC_lblTroopType = 1008
%IDC_GRATroops    = 1012
%IDC_SCROLLBAR1   = 1013
%IDC_cboTroops    = 1014
#PBFORMS END CONSTANTS
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------

DECLARE FUNCTION funDrawTroopStat(BYVAL lngSX AS LONG, BYVAL lngSY AS LONG) AS LONG


GLOBAL oldGraphicProc  AS DWORD
GLOBAL hDC             AS DWORD
GLOBAL X1, Y1, X2, Y2  AS DOUBLE
GLOBAL g_hdlg          AS DWORD
GLOBAL g_astrBoard()   AS STRING
GLOBAL ncWidth!, ncHeight!            ' height of graphics window
GLOBAL ghImgList AS DWORD
GLOBAL a_strSpartan() AS STRING
GLOBAL a_strGreek() AS STRING
GLOBAL g_lngGreekPicked AS LONG
GLOBAL g_lngGreekStatus() AS LONG
GLOBAL a_lngSpartanStats() AS LONG
GLOBAL a_lngGreekStats() AS LONG
'
%MaxTrees = 5
%MaxHills = 1
%TerrainX = 10
%TerrainY = 8
%MaxTroops = 9
'
FUNCTION GetAppPath AS STRING
' return the path of the application running
  LOCAL sPath AS STRING, zPath AS ASCIIZ * %MAX_PATH
  GetModuleFileName GetModuleHandle(""), zPath , %MAX_PATH
  sPath = LEFT$(zPath, INSTR(-1, zPath , "\"))
  FUNCTION = sPath
END FUNCTION
'
'------------------------------------------------------------------------------
'   ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
  PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR _
    %ICC_INTERNET_CLASSES)
  REDIM g_astrBoard(%TerrainX,%TerrainY)
  REDIM a_strSpartan(%MaxTroops) AS STRING
  REDIM a_lngSpartanStats(%MaxTroops) AS LONG
  REDIM a_lngGreekStats(%MaxTroops) AS LONG
  '
  a_strSpartan(1)= "SPT01"
  a_strSpartan(2)= "SPT02"
  a_strSpartan(3)= "SPT03"
  a_strSpartan(4)= "SPTH01"
  a_strSpartan(5)= "SPTJAV"
  a_strSpartan(6)= "SPT04"
  a_strSpartan(7) ="SPTCAV"
  a_strSpartan(8)= "SPTBAG"
  a_strSpartan(9)= "SPTCMD"

  REDIM a_strGreek(%MaxTroops) AS STRING
  a_strGreek(1) = "GRK01"
  a_strGreek(2) = "GRK02"
  a_strGreek(3) = "GRK03"
  a_strGreek(4) = "GRKH01"
  a_strGreek(5) = "GRKARCH"
  a_strGreek(6) = "GRK04"
  a_strGreek(7) = "GRKCAV"
  a_strGreek(8) = "GRKBAG"
  a_strGreek(9) = "GRKCMD"
  '
  REDIM g_lngGreekStatus(%MaxTroops) AS LONG

  ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------

FUNCTION funRandomiseTerrain() AS LONG
' place the terrain pieces
  DIM lngX AS LONG
  DIM lngY AS LONG
  DIM lngR AS LONG
  '
  RANDOMIZE
  FOR lngR = 1 TO %MaxTrees
    lngX = RND(1, UBOUND(g_astrBoard,1))
    lngY = RND(1, UBOUND(g_astrBoard,2))
    WHILE g_astrBoard(lngX,lngY)<>""
      lngX = RND(1, UBOUND(g_astrBoard,1))
      lngY = RND(1, UBOUND(g_astrBoard,2))
    WEND
    g_astrBoard(lngX,lngY) = "T"
  NEXT lngR
  '
  FOR lngR = 1 TO %MaxHills
    lngX = RND(1, UBOUND(g_astrBoard,1))
    lngY = RND(1, UBOUND(g_astrBoard,2))
    WHILE lngX<=1 OR lngY<=1 OR lngX>= %TerrainX OR lngY>= %TerrainY OR g_astrBoard(lngX,lngY)<>""
      lngX = RND(1, UBOUND(g_astrBoard,1))
      lngY = RND(1, UBOUND(g_astrBoard,2))
    WEND
    g_astrBoard(lngX,lngY) = "H"
  NEXT lngR
  FUNCTION = %TRUE
  '
END FUNCTION
'
FUNCTION funRandomiseTroops() AS LONG
' place some troops
  DIM lngX AS LONG
  DIM lngY AS LONG
  DIM lngR AS LONG
  DIM lngSQR AS LONG
  DIM strPiece AS STRING
  '
  REDIM PRESERVE a_strSpartan(1 TO UBOUND(a_strSpartan)) AS STRING
  ' draw the spartans
  'DATA SPT01,SPT02,SPT03,SPTH01,SPTJAV,SPT04,SPTCAV,SPTBAG,SPTCMD
  FOR lngR = 1 TO UBOUND(a_strSpartan)
    strPiece = a_strSpartan(lngR)
    SELECT CASE lngR
      CASE 1 TO 7
      ' front line troops
        lngSQR = RND(1,%TerrainX)
        WHILE g_astrBoard(lngSQR,2)<>""
          lngSQR = RND(1,%TerrainX)
        WEND
        '
        g_astrBoard(lngSQR,2)=strPiece
        '
      CASE ELSE
      ' back line troops
        lngSQR = RND(1,%TerrainX)
        WHILE g_astrBoard(lngSQR,1)<>"" OR LEFT$(g_astrBoard(lngSQR,2),1)<>"S"
          lngSQR = RND(1,%TerrainX)
        WEND
        '
        g_astrBoard(lngSQR,1)=strPiece
    END SELECT
  NEXT lngR
  '
  'g_astrBoard(1,1) = "SPT01"
  'g_astrBoard(2,2) = "SPT02"
  'g_astrBoard(3,2) = "SPT03"
  'g_astrBoard(4,2) = "SPTH01"
  'g_astrBoard(4,1) = "SPTBag"
  'g_astrBoard(3,1) = "SPTcmd"
  'g_astrBoard(5,2) = "SPTjav"
  'g_astrBoard(6,2) = "SPT04"
  'g_astrBoard(7,2) = "SPTCAV"

  '


 ' g_astrBoard(1,7) = "GRKH01"
 ' g_astrBoard(2,7) = "GRK01"
 ' g_astrBoard(3,7) = "GRK02"
 ' g_astrBoard(4,7) = "GRK03"
 ' g_astrBoard(2,8) = "GRKBAG"
 ' g_astrBoard(3,8) = "GRKCMD"
 ' g_astrBoard(5,7) = "GRKARCH"
 ' g_astrBoard(6,7) = "GRK04"
 ' g_astrBoard(7,7) = "GRKCAV"

  '
  FUNCTION = %TRUE
END FUNCTION
'
FUNCTION funDrawCurrentBoard() AS LONG
  DIM lngR AS LONG
  DIM lngC AS LONG
  DIM lngXCount AS LONG
  DIM lngYCount AS LONG
  DIM strPiece AS STRING

' now draw pieces
  FOR lngR = 0 TO ncWidth! STEP ncWidth!\%TerrainX
    INCR lngXCount
    FOR lngC = 0 TO ncHeight! STEP ncHeight!\%TerrainY
      INCR lngYCount
      IF lngXCount <= UBOUND(g_astrBoard,1) AND lngYCount <= UBOUND(g_astrBoard,2) THEN
        SELECT CASE g_astrBoard(lngXCount,lngYCount)
          CASE "T"
            strPiece = "TREES" ' GetAppPath & "tree1.bmp"
            GRAPHIC RENDER strPiece, (lngR , lngC +4)-(lngR+61,lngC + 64)
          CASE "H"
            strPiece = "HILL" 'GetAppPath & "hill.bmp"
            GRAPHIC RENDER strPiece, (lngR , lngC )-(lngR+66,lngC + 65)
          CASE ELSE
            strPiece = g_astrBoard(lngXCount,lngYCount)
            IF strPiece <>"" THEN   
            ' transparent copy
            ' Make sure your Masking Bitmap has a WHITE Background
            ' AND a BLACK Mask.
            ' The BITMAP itself must THEN have a BLACK Background again.
              'GRAPHIC COPY hBMP_Mask, 0 , %MIX_MASKSRC
              'GRAPHIC COPY hBMP, 0, %MIX_MERGESRC
              GRAPHIC RENDER strPiece, (lngR +10 , lngC + 5)-(lngR+63,lngC + 65)
              IF ISTRUE funDrawTroopStat(lngXCount,lngYCount) THEN
              ' draw the stats for this troop unit
              END IF
            END IF
            '
        END SELECT
        '
      ELSE

      END IF

    NEXT lngC
    lngYCount = 0
  NEXT lngR

  ' now draw the frames
  FOR lngR = 0 TO ncWidth! STEP ncWidth!\%TerrainX
      GRAPHIC LINE (lngR, 1) - (lngR, ncHeight!), %BLACK
  NEXT lngR
  '
  FOR lngC = 0 TO ncHeight! STEP ncHeight!\%TerrainY
      GRAPHIC LINE (1,lngC) - (ncWidth!,lngC),%BLACK
  NEXT lngC
  '
  GRAPHIC WIDTH 5
  GRAPHIC BOX (1,1) - (ncWidth!-2,ncHeight!-1), %BLACK
  '
  GRAPHIC REDRAW
  FUNCTION = %TRUE
  '
END FUNCTION
'
FUNCTION funGetDamage( strUnitType AS STRING) AS LONG
' get the damage of the unit
  DIM lngR AS LONG
  DIM I&
  '
  ' check spartans
  ARRAY SCAN a_strSpartan(), COLLATE UCASE, = strUnitType, TO I&
  IF I& = 0 THEN
  ' scan the greeks
    ARRAY SCAN a_strGreek(), COLLATE UCASE, = strUnitType, TO I&
    IF i& = 0 THEN
    ' not found
      FUNCTION = 0
      EXIT FUNCTION
    ELSE
      FUNCTION = 100 - a_lngGreekStats(I&)
    END IF
  ELSE
    FUNCTION = 100 - a_lngSpartanStats(I&)
  END IF
  '
END FUNCTION
'
FUNCTION funDrawTroopStat(BYVAL lngSX AS LONG, BYVAL lngSY AS LONG) AS LONG
' draw the stats of the troop unit
  ' turn back into pixel co-ordinates
  DIM lngXTop AS LONG
  DIM lngYTop AS LONG
  DIM lngX AS LONG
  DIM lngY AS LONG
  DIM lngDamage AS LONG
  ' work out the top left co-ordinate
  lngX = lngSX - 1
  lngY = lngSY - 1
  lngXTop = lngX * (ncWidth!\%TerrainX)
  lngYTop = lngY * (ncHeight!\%TerrainY)
  '
  ' now draw a green line for status
  GRAPHIC WIDTH 1
  GRAPHIC COLOR RGB(43,165,5)
  GRAPHIC BOX (lngXTop+10, lngYTop+10) - (lngXTop+30, lngYTop+14),,,-1
  '
  ' now show damage
  lngDamage = funGetDamage(g_astrBoard(lngSX,lngSY))  ' returns % damaged
  lngDamage = 20*lngDamage\100
  GRAPHIC COLOR %RED
  GRAPHIC BOX (lngXTop+30, lngYTop+10) - (lngXTop+30-lngDamage, lngYTop+14),,,-1

  ' return graphics to normal
  GRAPHIC WIDTH 1
  GRAPHIC COLOR %BLACK
  GRAPHIC REDRAW
  FUNCTION = %TRUE

'
END FUNCTION
'
FUNCTION funSetupTroopValues() AS LONG
' set up the basic troop stats
  DIM lngR AS LONG
  '
  REDIM a_lngSpartanStats(%MaxTroops) AS LONG
  REDIM a_lngGreekStats(%MaxTroops) AS LONG
  '
  FOR lngR = 1 TO %MaxTroops
    a_lngSpartanStats(lngR)=80
    a_lngGreekStats(lngR)=100
  NEXT lngR
  '
  FUNCTION = %TRUE
  '
END FUNCTION
'
FUNCTION funDrawBoard() AS LONG
' redraw the basic board
  '
  GRAPHIC CLEAR
  GRAPHIC PAINT (1,1), %GREEN
  '
  GRAPHIC WIDTH 1
  '
  REDIM g_astrBoard(%TerrainX,%TerrainY)
  '
  IF ISFALSE funRandomiseTerrain() THEN
  ' sort the terrain first
    EXIT FUNCTION
  END IF
  '
  IF ISFALSE funRandomiseTroops() THEN
  ' now do the troops
    EXIT FUNCTION
  END IF
  '
  IF ISFALSE funSetupTroopValues() THEN
  ' set up the basic troop stats
    EXIT FUNCTION
  END IF
  '
  IF ISFALSE funDrawCurrentBoard() THEN
  ' draw the current board
    EXIT FUNCTION
  END IF
  '
END FUNCTION
'------------------------------------------------------------------------------
'   ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
  LOCAL hGraphic AS DWORD
  LOCAL lngR AS LONG
  '
  SELECT CASE AS LONG CBMSG
    CASE %WM_INITDIALOG
      ' Initialization handler

        funDrawBoard
        CONTROL HANDLE CBHNDL, %IDC_MAP TO hGraphic
        GRAPHIC GET DC TO hDC
        REDIM apt(1 TO 4) AS POINTAPI
        oldGraphicProc = SetWindowLong(hGraphic, %GWL_WNDPROC, CODEPTR(GraphicProc))

      '
    CASE %WM_NCACTIVATE
      STATIC hWndSaveFocus AS DWORD
      IF ISFALSE CBWPARAM THEN
        ' Save control focus
        hWndSaveFocus = GetFocus()
      ELSEIF hWndSaveFocus THEN
        ' Restore control focus
        SetFocus(hWndSaveFocus)
        hWndSaveFocus = 0
      END IF
    '
    CASE %WM_DESTROY
        IF oldGraphicProc THEN SetWindowLong hGraphic, %GWL_WNDPROC, oldGraphicProc

    CASE %WM_COMMAND
      ' Process control notifications
      SELECT CASE AS LONG CBCTL
        CASE %IDC_NEWGAME
          IF CBCTLMSG = %STN_CLICKED OR CBCTLMSG = 1 THEN
            CONTROL SHOW STATE g_hDlg,%IDC_lblTroopType, %SW_SHOW
            CONTROL SHOW STATE g_hDlg,%IDC_GRATroops, %SW_SHOW
            CONTROL SHOW STATE g_hDlg,%IDC_SCROLLBAR1, %SW_SHOW
            FOR lngR= 1 TO UBOUND(g_lngGreekStatus)
              g_lngGreekStatus(lngR) = %FALSE
            NEXT lngR
            ' reset the scrollbar to 1
            g_lngGreekPicked = 1
            CONTROL SEND CBHNDL,%IDC_SCROLLBAR1, %SBM_SETPOS, g_lngGreekPicked, %TRUE
            GRAPHIC ATTACH CBHNDL, %IDC_GRATroops , REDRAW
            GRAPHIC RENDER a_strGreek(g_lngGreekPicked), (0,0)-(63,65)
            GRAPHIC REDRAW
            GRAPHIC ATTACH CBHNDL, %IDC_MAP, REDRAW
            funDrawBoard
          END IF
          '
        CASE %IDC_MAP
          IF CBCTLMSG = %STN_CLICKED OR CBCTLMSG = 1 THEN
             'X2,Y2  are the co-ordinates
               GRAPHIC RENDER GetAppPath & "tree.bmp", (x2, y2)-(41,40)
               GRAPHIC REDRAW
              ' GRAPHIC RENDER "E:\pbwin80\samples\Graphics\piece.bmp", (1, 1)-(20,20)
            'MSGBOX STR$(x2) & " " & STR$(y2)
          END IF
          '
        CASE %IDC_NEWGAME
          IF CBCTLMSG = %STN_CLICKED OR CBCTLMSG = 1 THEN
            funDrawBoard()
          END IF
          '
        CASE %IDC_IMGTroops
          IF CBCTLMSG = %STN_CLICKED OR CBCTLMSG = 1 THEN
            'MOUSEPTR 5
          END IF

      END SELECT
  END SELECT
END FUNCTION
'------------------------------------------------------------------------------
SUB AddTextAndPicture (BYVAL hDlg AS DWORD, txt AS STRING, BYVAL bmpFile AS STRING)

    LOCAL idxImage AS LONG
    LOCAL hBmp     AS DWORD
    LOCAL cbI      AS COMBOBOXEXITEM

    hBmp = LoadImage(0, BYVAL STRPTR(bmpFile), %IMAGE_BITMAP, 0, 0, %LR_LOADFROMFILE)
    IF hBmp THEN
        idxImage = ImageList_Add(ghImgList, hBmp, %NULL)
        DeleteObject hBmp

        cbI.mask = %CBEIF_TEXT OR %CBEIF_IMAGE OR %CBEIF_SELECTEDIMAGE 'OR %CBEIF_INDENT
        cbI.iItem          = -1
        cbI.pszText        = STRPTR(txt)
        cbI.cchTextMax     = LEN(txt)
        cbI.iImage         = idxImage
        cbI.iSelectedImage = idxImage
        'cbI.iIndent       = 1  ' If item indention testing is required

        CONTROL SEND hDlg, %IDC_cboTroops, %CBEM_INSERTITEM, 0, VARPTR(cbI)
    END IF

END SUB
'
SUB UpdateLabel ( BYVAL hParent AS DWORD, _
                  BYVAL  CtrlID AS LONG , _
                  BYVAL tSB     AS SCROLLINFO PTR )

  DIM Flag AS LOCAL LONG
  DIM P    AS LOCAL CUX

  IF CtrlID = 0 THEN EXIT SUB

  CONTROL GET USER hParent, CtrlID, 8 TO Flag

  IF Flag THEN
      P = @tSB.nPos / @tSB.nMax
      P = MAX(P,0.01)
      P = MIN(P,1)
      CONTROL SET TEXT hParent, CtrlID, FORMAT$(P,"0%")
    ELSE
      CONTROL SET TEXT hParent, CtrlID, FORMAT$(@tSB.nPos)
  END IF

END SUB

'
CALLBACK FUNCTION ScrollbarCallback

  DIM  Ctrl AS LOCAL LONG                                        ' CBLPARAM = handle of scrollbar
  DIM hCtrl AS LOCAL DWORD                                       ' CBLPARAM = handle of scrollbar
  DIM tSB   AS LOCAL SCROLLINFO PTR                              '
                                                                 '
  IF (CBMSG <> %WM_VSCROLL )  AND _                              '
     (CBMSG <> %WM_HSCROLL ) THEN EXIT FUNCTION                  ' not for us!
                                                                 '
  DIALOG GET USER CBLPARAM, 8 TO tSB                             ' get the UDT pointer
  SELECT CASE LOWRD(CBWPARAM)                                    ' get the hot command
    CASE %SB_LINEDOWN       : INCR @tSB.nPos                     '
    CASE %SB_PAGEDOWN       : @tSB.nPos = @tSB.nPos + @tSB.nPage '
    CASE %SB_LINEUP         : DECR @tSB.nPos                     '
    CASE %SB_PAGEUP         : @tSB.nPos = @tSB.nPos - @tSB.nPage '
    CASE %SB_THUMBPOSITION, _                                    '
         %SB_THUMBTRACK     : @tSB.nPos = HIWRD(CBWPARAM)        '
    CASE %SB_BOTTOM         : @tSB.nPos = @tSB.nMax              '
    CASE %SB_TOP            : @tSB.nPos = 1                      '
    CASE %SB_ENDSCROLL      : EXIT FUNCTION                      '
  END SELECT                                                     '
  @tSB.nPos = MAX(@tSB.nMin, @tSB.nPos)                          ' can't be less than minimum
  @tSB.nPos = MIN(@tSB.nMax, @tSB.nPos)                          ' can't be more than maximim
  DIALOG SEND CBLPARAM, %SBM_SETPOS, @tSB.nPos, %TRUE            '
  ' put the right graphic in
  GRAPHIC ATTACH g_hDlg, %IDC_GRATroops , REDRAW
  GRAPHIC RENDER a_strGreek(@tSB.nPos), (0,0)-(63,65)
  g_lngGreekPicked = @tSB.nPos
  GRAPHIC REDRAW
  GRAPHIC ATTACH g_hdlg, %IDC_MAP, REDRAW
  '
  FUNCTION = 1                                                   ' send an 'I'm done' message to Windows

END FUNCTION

'------------------------------------------------------------------------------
'   ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
  LOCAL lRslt AS LONG
  LOCAL w, h AS LONG
  DIM tSB(2) AS LOCAL SCROLLINFO
  '
#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
  LOCAL hDlg  AS DWORD

  DIALOG NEW PIXELS, hParent, "Sparta", 46, 80, 812, 609, %WS_POPUP OR _
    %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
    %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_SETFOREGROUND _
    OR %DS_CENTER OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
    %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
    %WS_EX_RIGHTSCROLLBAR, TO hDlg
  CONTROL ADD GRAPHIC,   hDlg, %IDC_MAP, "", 15, 16, 690, 538, %WS_CHILD OR _
    %WS_VISIBLE OR %WS_BORDER OR %SS_SUNKEN OR %SS_NOTIFY
  CONTROL ADD IMAGE,     hDlg, %IDC_IMAGE1, "#" + FORMAT$(%IDR_IMGFILE1), _
    712, 8, 82, 80
  CONTROL ADD IMAGE,     hDlg, %IDC_IMAGE2, "#" + FORMAT$(%IDR_IMGFILE2), _
    712, 471, 86, 78, %WS_CHILD OR %WS_VISIBLE OR %SS_BITMAP OR _
    %SS_CENTERIMAGE
  CONTROL ADD BUTTON,    hDlg, %IDC_NEWGAME, "New Game", 15, 569, 75, 23
  CONTROL ADD LABEL,     hDlg, %ID_POSIT, "", 555, 569, 145, 14
  CONTROL ADD IMAGE,     hDlg, %IDC_IMGicon, "#" + FORMAT$(%IDR_IMGFILE3), _
    750, 114, 32, 32, %WS_CHILD OR %WS_VISIBLE OR %SS_ICON
  CONTROL ADD LABEL,     hDlg, %IDC_lblTroopType, "Select Troop type", 720, _
    171, 75, 32, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR _
    %WS_EX_LTRREADING
  CONTROL SET COLOR      hDlg, %IDC_lblTroopType, %BLUE, -1
  CONTROL ADD GRAPHIC,   hDlg, %IDC_GRATroops, "", 712, 203, 68, 73, _
    %WS_CHILD OR %WS_VISIBLE OR %SS_SUNKEN OR %SS_NOTIFY, %WS_EX_CLIENTEDGE
  CONTROL ADD SCROLLBAR, hDlg, %IDC_SCROLLBAR1, "ScrollBar1", 780, 203, 15, _
    73, %WS_CHILD OR %WS_VISIBLE OR %SBS_VERT , CALL ScrollbarCallback
#PBFORMS END DIALOG
  g_hdlg = hDlg
  '
  GRAPHIC ATTACH hDlg, %IDC_GRATroops , REDRAW
  CONTROL GET CLIENT hDlg, %IDC_GRATroops TO w, h   'get client size
  GRAPHIC SCALE (0, 0) - (w, h)               'scale to pixel coordinate system
  GRAPHIC RENDER a_strGreek(1), (0,0)-(63,65)
  '
  GRAPHIC ATTACH hdlg, %IDC_MAP, REDRAW
  CONTROL GET CLIENT hDlg, %IDC_MAP TO w, h   'get client size
  GRAPHIC SCALE (0, 0) - (w, h)               'scale to pixel coordinate system
  '
  CONTROL SET IMAGE hDlg, %IDC_IMGTroops, "GRKH01"

  ' store the graphic size
  GRAPHIC GET CLIENT TO ncWidth!, ncHeight!
  '
  tSB(0).cbSize = SIZEOF(SCROLLINFO)                            ' size of UDT
  tSB(0).fMask  = %SIF_ALL                                      ' Sets nPage, nPos, nMin, and nMax
  tSB(0).nMin   =   1                                           ' 1st position
  tSB(0).nMax   =  11                                           ' Last position + nPage - 1
  tSB(0).nPage  =  1                                            ' size of cursor block
  tSB(0).nPos   =  1                                            ' starting position
  CONTROL SET USER hDlg, %IDC_SCROLLBAR1, 8, VARPTR(tSB(0))     ' store pointer to UDT
  CONTROL SEND hDlg, %IDC_SCROLLBAR1, %SBM_SETSCROLLINFO, _
                     %TRUE, VARPTR(tSB(0))                      ' initialize the scrollbar & redraw
  tSB(0).nMax  = 10
  g_lngGreekPicked = tSB(0).nPos
  '
  CONTROL SHOW STATE hDlg, %IDC_IMGicon, %SW_HIDE
  DIALOG SET ICON hDlg , "#" + FORMAT$(%IDR_IMGFILE3)

  DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP

  FUNCTION = lRslt
END FUNCTION
'
FUNCTION funSQR(BYVAL X AS DOUBLE,BYVAL Y AS DOUBLE) AS STRING
' work out the square mouse is pointing at
  DIM lngX AS LONG
  DIM lngY AS LONG
  lngX = (X\(ncWidth!\%TerrainX))+1
  lngY = (Y\(ncHeight!\%TerrainY)+1)
  ' return the top left hand co-ordinates of the square the mouse is in
  FUNCTION = TRIM$(STR$(lngX)) & " " & TRIM$(STR$(lngY))
'
END FUNCTION

'------------------------------------------------------------------------------
SUB MouseMove(BYVAL hWnd AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
   LOCAL i AS LONG

   X2 = LO(INTEGER, lParam)  :  Y2 = HI(INTEGER, lParam)
   CONTROL SET TEXT GetParent(hWnd), %ID_POSIT, "Pos : " + STR$(X2) + "," + STR$(Y2) + funSQR(X2,Y2)
END SUB

SUB LeftButtonUp(BYVAL hWnd AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
'
   DIM lngX AS LONG
   DIM lngY AS LONG
   DIM lngXtop AS LONG
   DIM lngYtop AS LONG
   DIM strSQR AS STRING
   DIM hBmp AS DWORD
   DIM lngR AS LONG
   DIM lngCount AS LONG
   '
   IF ISTRUE g_lngGreekStatus(g_lngGreekPicked) THEN
   ' this piece already picked
     EXIT SUB
   END IF
   '
   '  x2, y2 are the mouse co-ordinates
   '  get the sqr
   strSQR = funSQR(X2,Y2)
   ' turn back into pixel co-ordinates
   lngX = VAL(PARSE$(strSQR," ",1))-1
   lngY = VAL(PARSE$(strSQR," ",2))-1
   lngXTop = lngX * (ncWidth!\%TerrainX)
   lngYTop = lngY * (ncHeight!\%TerrainY)

  '  GRAPHIC RENDER "TREES", (lngXTop+2, lngYTop+4)-(lngXTop+61,lngYTop+60)
  IF g_astrBoard(lngX+1,lngY+1)="" OR LEFT$(g_astrBoard(lngX+1,lngY+1),1)="H" THEN
  ' decide the graphic to render
    GRAPHIC RENDER a_strGreek(g_lngGreekPicked), (lngXTop+10, lngYTop+5)-(lngXTop+63,lngYTop+65)
    g_astrBoard(lngX+1,lngY+1) = a_strGreek(g_lngGreekPicked)
    g_lngGreekStatus(g_lngGreekPicked) = %TRUE
    ' now check for all deployed
    FOR lngR= 1 TO UBOUND(g_lngGreekStatus)
      IF ISTRUE g_lngGreekStatus(lngR) THEN
        INCR lngCount
      END IF
    NEXT lng
    '
    IF lngCount = UBOUND(g_lngGreekStatus) THEN
    ' all deployed
      CONTROL SHOW STATE g_hDlg,%IDC_lblTroopType, %SW_HIDE
      CONTROL SHOW STATE g_hDlg,%IDC_GRATroops, %SW_HIDE
      CONTROL SHOW STATE g_hDlg,%IDC_SCROLLBAR1, %SW_HIDE
      '
    ELSE
      INCR g_lngGreekPicked
      CONTROL SEND g_hDlg,%IDC_SCROLLBAR1, %SBM_SETPOS, g_lngGreekPicked, %TRUE
      ' put the right graphic in
      GRAPHIC ATTACH g_hDlg, %IDC_GRATroops , REDRAW
      GRAPHIC RENDER a_strGreek(g_lngGreekPicked), (0,0)-(63,65)
      GRAPHIC REDRAW
      GRAPHIC ATTACH g_hdlg, %IDC_MAP, REDRAW
    END IF
  END IF
  GRAPHIC REDRAW
END SUB

' Subclass procedure
FUNCTION GraphicProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS LONG, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
   SELECT CASE wMsg
      CASE %WM_MOUSEMOVE    :  CALL MouseMove       (hWnd, wParam, lParam)
'      CASE %WM_LBUTTONDOWN  :  CALL LeftButtonDown  (hWnd, wParam, lParam)
      CASE %WM_LBUTTONUP    :  CALL LeftButtonUp    (hWnd, wParam, lParam)
'      CASE %WM_RBUTTONUP    :  CALL RightButtonDown (hWnd)
   END SELECT
   FUNCTION = CallWindowProc(oldGraphicProc, hWnd, wMsg, wParam, lParam)
END FUNCTION
